home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 3
/
Info_Mac_1994-01.iso
/
Development
/
General
/
XLisp 2.1e3
/
Sources
/
macfun.c
< prev
next >
Wrap
Text File
|
1993-09-18
|
6KB
|
225 lines
/* macfun.c - macintosh user interface functions for xlisp */
/* Written by Brian Kendig. */
#include <Quickdraw.h>
#include <Windows.h>
#include <Memory.h>
#include "xlisp.h"
/* externals */
extern GrafPtr commandWin, graphicsWin;
extern Boolean hasColorQD;
extern unsigned long startupTicks;
extern void ShowGrafWin (void);
extern void HideGrafWin (void);
extern void MacWrapUp (void);
LVAL xrealtime (void) { return cvfixnum ((FIXTYPE)real_tick_count()); } /* get-internal-real-time */
LVAL xruntime (void) { return cvfixnum ((FIXTYPE)run_tick_count()); } /* get-internal-run-time */
LVAL xtime (void) { return cvfixnum ((FIXTYPE)real_tick_count()); } /* time */
unsigned long ticks_per_second (void) { return 60; }
unsigned long run_tick_count (void) { return ((unsigned long) TickCount ()) - startupTicks; }
unsigned long real_tick_count (void) { return (unsigned long) TickCount (); }
/* get an integer parameter */
LOCAL int getNumber () {
LVAL num = xlgafixnum ();
return ((int) getfixnum (num));
}
/* handle commands that require integer arguments */
LOCAL LVAL GrafCmd (char funct, int nArgs) {
short x, y, z;
if (nArgs > 0) x = getNumber ();
if (nArgs > 1) y = getNumber ();
if (nArgs > 2) z = getNumber ();
xllastarg ();
SetPort (graphicsWin);
switch (funct) {
case 'G': ShowGrafWin (); break;
case 'g': HideGrafWin (); break;
case 'x': EraseRect (&graphicsWin->portRect); break;
case 's': ShowPen (); break;
case 'h': HidePen (); break;
case 'd': PenMode (x); break;
case 'M': Move (x, y); break;
case 'm': MoveTo (x, y); break;
case 'L': Line (x, y); break;
case 'l': LineTo (x, y); break;
case 'S': PenSize (x, y); break;
case 'p': PenNormal (); break;
case 'c':
if (hasColorQD) {
RGBColor col; col.red = x; col.green = y; col.blue = z;
RGBForeColor (&col);
} break;
}
SetPort (commandWin);
return NIL;
}
LVAL xshowgraphics (void) { return GrafCmd ('G', 0); } /* show graphics win */
LVAL xhidegraphics (void) { return GrafCmd ('g', 0); } /* hide graphics win */
LVAL xcleargraphics (void) { return GrafCmd ('x', 0); } /* clear graphics win */
LVAL xshowpen (void) { return GrafCmd ('s', 0); } /* show the pen */
LVAL xhidepen (void) { return GrafCmd ('h', 0); } /* hide the pen */
LVAL xpenmode (void) { return GrafCmd ('d', 1); } /* set the pen mode */
LVAL xmove (void) { return GrafCmd ('M', 2); } /* move pen in a specified direction */
LVAL xmoveto (void) { return GrafCmd ('m', 2); } /* move pen to a screen location */
LVAL xdraw (void) { return GrafCmd ('L', 2); } /* draw a line in a specified direction */
LVAL xdrawto (void) { return GrafCmd ('l', 2); } /* draw a line to a screen location */
LVAL xpensize (void) { return GrafCmd ('S', 2); } /* set the pen size */
LVAL xpennormal (void) { return GrafCmd ('p', 0); } /* set the pen to normal */
LVAL xcolor (void) { return GrafCmd ('c', 3); } /* set RGB color of pen */
LVAL xgetpen (void) { /* get the pen position */
LVAL val;
Point p;
xllastarg ();
SetPort ((GrafPtr)graphicsWin);
GetPen (&p);
SetPort (commandWin);
xlsave1 (val);
val = consa (NIL);
rplaca (val,cvfixnum ((FIXTYPE)p.h));
rplacd (val,cvfixnum ((FIXTYPE)p.v));
xlpop ();
return val;
}
LVAL xpenpat (void) { /* set the pen pattern */
LVAL plist;
Pattern pat;
int i;
plist = xlgalist ();
xllastarg ();
for (i = 0; i < 8 && consp (plist); ++i, plist = cdr (plist))
if (fixp (car (plist))) pat[i] = getfixnum (car (plist));
SetPort ((GrafPtr)graphicsWin);
PenPat (pat);
SetPort (commandWin);
return NIL;
}
/* The functions below are not yet implemented. */
LVAL xtool (void) { /* call the toolbox */
int trap = getNumber ();
LVAL val;
/* asm {
move.l args(A6),D0
beq L2
L1: move.l D0,A0
move.l 2(A0),A1
move.w 4(A1),-(A7)
move.l 6(A0),D0
bne L1
L2: lea L3,A0
move.w trap(A6),(A0)
L3: dc.w 0xA000
clr.l val(A6)
}
return val; */
return cvfixnum ((FIXTYPE) trap);
}
LVAL xtool16 (void) { /* call the toolbox with a 16 bit result */
int trap = getNumber ();
int val;
/* asm {
clr.w -(A7)
move.l args(A6), D0
beq L2
L1: move.l D0, A0
move.l 2(A0), A1
move.w 4(A1), -(A7)
move.l 6(A0), D0
bne L1
L2: lea L3, A0
move.w trap(A6), (A0)
L3: dc.w 0xA000
move.w (A7)+, val(A6)
}
return cvfixnum ((FIXTYPE) val); */
return cvfixnum ((FIXTYPE) trap);
}
LVAL xtool32 (void) { /* call the toolbox with a 32 bit result */
int trap = getNumber ();
long val;
/* asm {
clr.l -(A7)
move.l args(A6),D0
beq L2
L1: move.l D0,A0
move.l 2(A0),A1
move.w 4(A1),-(A7)
move.l 6(A0),D0
bne L1
L2: lea L3,A0
move.w trap(A6),(A0)
L3: dc.w 0xA000
move.l (A7)+,val(A6)
}
return cvfixnum ((FIXTYPE) val); */
return cvfixnum ((FIXTYPE) trap);
}
LVAL xnewhandle (void) { /* allocate a new handle */
LVAL num = xlgafixnum ();
long size = getfixnum (num);
xllastarg ();
return cvfixnum ((FIXTYPE) NewHandle (size));
}
LVAL xnewptr (void) { /* allocate memory */
LVAL num = xlgafixnum ();
long size = getfixnum (num);
xllastarg ();
return cvfixnum ((FIXTYPE) NewPtr (size));
}
LVAL xhiword (void) { /* return the high order 16 bits of an integer */
unsigned int val = (unsigned int) (getNumber () >> 16);
xllastarg ();
return cvfixnum ((FIXTYPE) val);
}
LVAL xloword (void) { /* return the low order 16 bits of an integer */
unsigned int val = (unsigned int) getNumber ();
xllastarg ();
return cvfixnum ((FIXTYPE) val);
}
LVAL xrdnohang (void) { /* get the next character in the look-ahead buffer */
int ch = 0;
xllastarg ();
/* if ((ch = scrnextc ()) == EOF) return NIL; */
return cvfixnum ((FIXTYPE) ch);
}
void ossymbols (void) { /* ossymbols - enter important symbols */
LVAL sym;
/* setup globals for the window handles */
sym = xlenter ("*COMMAND-WINDOW*");
setvalue (sym, cvfixnum ((FIXTYPE) commandWin));
sym = xlenter ("*GRAPHICS-WINDOW*");
setvalue (sym, cvfixnum ((FIXTYPE) graphicsWin));
}
void xoserror (char *msg) { /* do nothing */ }
LVAL xsystem (V) { return NIL; }
LVAL xgetkey (V) { return NIL; }